perm filename TVIOF.F4[PIC,LCS]2 blob sn#092574 filedate 1974-02-12 generic text, type T, neo UTF8
C	TVIOF			NOVEMBER 9, 69 			                 TVIOF

	COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
	1 DEBUG,T,XP,YP,PARMAX,
	1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND

	COMMON /LISTC/ LIST,LIST5,NEWEND,LO

	COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
	1 LSIDE,RSIDE,DTA,HYSTAB

	DIMENSION LIST5(0/1000),LIST(6,1000),BTLIP(0/15),
	1 XP(0/176),YP(0/176),T(0/1415),HYSTAB(0/15)

	INTEGER BCLIP,TCLIP,BITS,FLINE,LLINE,
	1 LSIDE,RSIDE,HYSTAB,DTA,IB,HEL,I,TIM1,TIM2,TIM4,TIM5,
	1 TAPE,FILEN,NEWEND,ALFAB,YES,NO,FILE,BTLIP,LIP

	REAL INT,HIG,QAL,QALOLD,NUPO,TIM3,HIL,HILOLD

	LOGICAL LOAP,LOAU,PLAY,SAVU,SAVP,NOPR,NOLU,NOLP
CC	LOGICAL FUNCTION ADMISS
CC	ADMISS(DTA)=DTA.EQ.-7.OR.(1.LE.DTA.AND.DTA.LE.10)
	TAPE=1
	DTA=-7
	CALL TIMER(TIM1)
1	CALL INITAL
	BCLIP=7
	TCLIP=0
	BITS=4
	FLINE=20
	LLINE=250
	LSIDE=6
	RSIDE=302
C	IWID=RSIDE-LSIDE+1
C	I=36/BITS
C	LINLEN=(IWID+I-1)/I
C	TVSZ=(LLINE-FLINE+1)*LINLEN
	YES='Y'
	NO ='N'
	SAVU=.FALSE.
C	UNPROCESSED PICTURE HAS BEEN SAVED IF SAVU.EQ..TRUE.
	SAVP=.FALSE.
C	PROCESSED PICTURE HAS BEEN SAVED
	LOAP=.FALSE.
C	PROCESSED PICTURE HAS BEEN LOADED
	LOAU=.FALSE.
C	UNPROCESSED PICTURE HAS BEEN LOADED
	PLAY=.FALSE.
C	PROGRAMS PICTURE WAS OFFERED OR OVER WRITTEN
	NOPR=.FALSE.
C	PROCESSING NOT WANTED
	NOLU=.FALSE.
C	LOADING OF UNPROCESSED NOT WANTED
	NOLP=.FALSE.
C	LOADING OF PROCESSED NOT WANTED
3	FORMAT(' DO YOU WANT TO TAKE A PICTURE WITH THE TV CAMERA ?'/)
	TYPE 3
6	ACCEPT 83,ALFAB
	IF(ALFAB.EQ.YES) GOTO 8
	IF(ALFAB.EQ.NO ) GOTO 158
C	TYPE 103
	GOTO 3
8	DO 9 I=0,15
9	BTLIP(I)=7-I/2
7	FORMAT(' DO YOU WANT TO READ A FRAME
	1 OTHER THAN THE MAXIMAL ?'/)
16	TYPE 7
	ACCEPT 83, ALFAB
	IF(ALFAB.EQ.YES) GOTO 18
	IF(ALFAB.EQ.NO ) GOTO 17
CC	TYPE 103
	GOTO 16
18	TYPE 19
19	FORMAT(' TYPE  FLINE, LLINE, LSIDE, RSIDE'/)
20	FORMAT(4I)
	ACCEPT 20,FLINE,LLINE,LSIDE,RSIDE
21	FORMAT(4I4/)
	TYPE 21,FLINE,LLINE,LSIDE,RSIDE
17	CALL TVIN
	CALL HISTO
	TYPE 63,BCLIP,TCLIP,(HYSTAB(I),I,BTLIP(I),I=0,15)
10	FORMAT(' DO YOU WANT TO OVER WRITE AUTOMATIC CLIP
	1 LEVEL SETTING ?'/)
30	TYPE 10
11	ACCEPT 83,ALFAB
	IF(ALFAB.EQ.YES) GOTO 13
	IF(ALFAB.EQ. NO) GOTO 62
CC	TYPE 103
	GOTO 11
12	FORMAT(' TYPE BCLIP'/)
13	TYPE 12
	ACCEPT 133,BCLIP
15	FORMAT(1H+,I1/)
	TYPE 15,BCLIP
14	FORMAT(' TYPE TCLIP'/)
	TYPE 14
	ACCEPT 133,TCLIP
	TYPE 15, TCLIP
	GOTO 67
62	CALL CLIPS
63	FORMAT(7H BCLIP=I2/7H TCLIP=I2//16(I7,2I4/))
66	FORMAT(' RETURN CARRIAGE FOR FINAL TV READING',$)
67	TYPE 66
	ACCEPT 83,ALFAB
	DO 64 I=0,15
	HILOLD=HIL
	HIL=(1.0-(FLOAT(I)-0.5)/14.0)*(BCLIP-TCLIP)+TCLIP
	BTLIP(I)=-0
	IF(I.EQ.0) GOTO 64
	LIP=IFIX(HILOLD)
	IF(IFIX(HIL).EQ.LIP) GOTO 64
	BTLIP(I-1)=LIP
	BTLIP(I) = LIP
64	CONTINUE
	CALL TVIN
	CALL HISTO
	TYPE 63,BCLIP,TCLIP,(HYSTAB(I),I,BTLIP(I),I=0,15)
68	FORMAT(' IS THIS ACCEPTABLE ?'/)
69	TYPE 68
	ACCEPT 83,ALFAB
	IF(ALFAB.EQ.YES) GOTO 71
	IF(ALFAB.EQ.NO ) GOTO 30
CC	TYPE 103
	GOTO 69
71	LOAU=.TRUE.
75	IF(SAVU) GOTO 152
73	FORMAT(' DO YOU WANT TO SAVE THE UNPROCESSED IMAGE ?'/)
	TYPE 73
83	FORMAT(A5)
93	ACCEPT 83,ALFAB
	IF(ALFAB.EQ.YES) GOTO 173
CC	IF(ALFAB.EQ.YES) GOTO 123
	IF(ALFAB.EQ.NO ) GOTO 151
CC103	FORMAT(33H PLEASE ANSWER ONLY 'YES' OR 'NO'/)
CC	TYPE 103
	GOTO 73
CC113	FORMAT(' TYPE NUMBER OF OUTPUT DRIVE'/)
CC123	TYPE 113
133	FORMAT(I)
CC	ACCEPT 133,DTA
CC183	FORMAT(1H+,I2/)
CC	TYPE 183,DTA
CC	IF(ADMISS(DTA)) GOTO 173
CC184	FORMAT(' THIS NUMBER IS NOT PERMISSIBLE'/' FOR DSK TAKE DRIVE -7'/
CC	1' FOR MTA0 TAKE DRIVE 8'/' FOR MTA1 TAKE DRIVE 9'/)
CC	TYPE 184
CC	GOTO 123
193	FORMAT(' GIVE THE FILE A NAME'/)
173	TYPE 193
	ACCEPT 83,FILE
CC	TYPE 253,FILE
	CALL DECDMP
	SAVU=.TRUE.
	GOTO 158
151	SAVU=.TRUE.
152	IF(NOPR) GOTO 340
188	FORMAT(' DO YOU WANT TO PROCESS THE IMAGE ?'/)
	TYPE 188
198	ACCEPT 83,ALFAB
	IF(ALFAB.EQ.YES) GOTO 203
	IF(ALFAB.EQ.NO ) GOTO 307
CC	TYPE 103
	GOTO 188
158	IF(NOLU) GOTO 308
156	FORMAT(' DO YOU WANT TO LOAD AN UNPROCESSED IMAGE ?'/)
	TYPE 156
160	ACCEPT 83,ALFAB
	IF(ALFAB.EQ.YES) GOTO 205
CC	IF(ALFAB.EQ.YES) GOTO 165
	IF(ALFAB.EQ.NO ) GOTO 304
CC	TYPE 103
	GOTO 156
CC164	FORMAT(' TYPE NUMBER OF INPUT DRIVE'/)
CC165	TYPE 164
CC174	ACCEPT 133,DTA
CC	TYPE 183,DTA
CC	IF(ADMISS(DTA)) GOTO 205
CC	TYPE 165
CC	GOTO 174
204	FORMAT(' TYPE THE FILE NAME'/)
205	TYPE 204
	ACCEPT 83,FILE
CC	TYPE 253,FILE
	CALL DECINP
	LOAU=.TRUE.
	SAVU=.FALSE.
	NOPR=.FALSE.
	GOTO 75
203	CALL SCAHEX
	SAVP=.FALSE.
	NOLU=.FALSE.
	PLAY=.TRUE.
202	FORMAT(' NEWEND=',I4/)
	TYPE 202,NEWEND
199	LOAP=.TRUE.
209	CONTINUE
210	IF(.NOT.LOAP) GOTO 1
218	CONTINUE
219	IF(SAVP) GOTO 235
	IF(.NOT.LOAP) GOTO 1
213	FORMAT(' DO YOU WANT TO SAVE THE PROCESSED IMAGE ?'/)
	TYPE 213
223	ACCEPT 83,ALFAB
	IF(ALFAB.EQ.YES) GOTO 243
	IF(ALFAB.EQ.NO ) GOTO 235
CC	TYPE 103
	GOTO 213
CC233	TYPE 113
CC	ACCEPT 133,DTA
CC	TYPE 183,DTA
CC	IF(ADMISS(DTA)) GOTO 243
CC	TYPE 184
CC	GOTO 233
243	TYPE 193
	ACCEPT 83,FILE
253	FORMAT(1H+,A5/)
CC	TYPE 253,FILE
CC	TAPE=8+DTA
	FILEN=6*(NEWEND+1)
	CALL ZERPP
	CALL OFILE(TAPE,FILE)
	WRITE(TAPE) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
	1 ((LIST(I,N),I=1,6),N=1,NEWEND)
	END FILE TAPE
	SAVP=.TRUE.
	NOLP=.FALSE.
	IF(LOAU) GOTO 75
235	IF(.NOT.LOAP) GOTO 1
CC230	FORMAT(' DO YOU WANT TO PLOT THE IMAGE ?'/)
CC	TYPE 230
CC240	ACCEPT 83,ALFAB
CC	IF(ALFAB.EQ.YES) GOTO 250
CC	IF(ALFAB.EQ.NO ) GOTO 260
CCCC	TYPE 103
CC	GOTO 240
CC250	CONTINUE
252	CALL PLOU
	SHOW=.TRUE.
	LOAP=.FALSE.
	NOPR=.FALSE.
	PLAY=.TRUE.
	SAVP=.TRUE.
	NOLP=.FALSE.
	GOTO 260
304	NOLU=.TRUE.
305	IF(LOAU) GOTO 152
300	FORMAT(' DO YOU WANT TO LOAD A PROCESSED IMAGE ?'/)
	GOTO 306
307	NOPR=.TRUE.
306	IF(PLAY) GOTO 235
308	IF(NOLP) GOTO 260
	TYPE 300
310	ACCEPT 83,ALFAB
	IF(ALFAB.EQ.YES) GOTO 320
	IF(ALFAB.EQ.NO ) GOTO 338
CC	TYPE 103
	GOTO 308
320	NAME=.TRUE.
CC	TYPE 164
CC	ACCEPT 133,DTA
CC	TYPE 183,DTA
CC	IF(ADMISS(DTA)) GOTO 330
CC	TYPE 184
CC	GOTO 320
330	TYPE 204
	ACCEPT 83,FILE
CC	TYPE 253,FILE
	DO 335 I=1,6000
335	LIST(I,1)=0.
CC	TAPE=8+DTA
CC	CALL ZERPP
	REWIND TAPE
	CALL IFILE(TAPE,FILE)
	READ(TAPE) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
	1 ((LIST(I,N),I=1,6),N=1,NEWEND)
	TYPE 202,NEWEND
	SHOW=.FALSE.
	LOAP=.TRUE.
	PLAY=.TRUE.
	NOLP=.FALSE.
	SAVP=.FALSE.
	GOTO 199
338	IF(NOLP.AND.LOAU.AND.SAVU.AND.NOPR) GOTO 261
	NOLP=.TRUE.
340	IF(.NOT.LOAP) GOTO 260
	IF(PLAY) GOTO 260
339	FORMAT(' AN IMAGE WAS LOADED WITH THE PROGRAM'//)
	TYPE 339
	PLAY=.TRUE.
	LOAP=.TRUE.
	GOTO 210
341	IF(NOLP) GOTO 261
	GOTO 308
260	IF(SAVU.AND.NOPR.AND.(.NOT.LOAP).AND.LOAU) GOTO 341
	IF(LOAU) GOTO 75
261	CALL TIMER(TIM2)
	TIM3=FLOAT(TIM2-TIM1)/60000.
163	FORMAT(' THIS RUN CONSUMED ',F5.3,' MINUTES OF COMPUTING TIME'/)
	TYPE 163,TIM3
	END